home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / mforma.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  13.3 KB  |  438 lines

  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;;     The data in this file contains enhancments.                    ;;;;;
  4. ;;;                                                                    ;;;;;
  5. ;;;  Copyright (c) 1984,1987 by William Schelter,University of Texas   ;;;;;
  6. ;;;     All rights reserved                                            ;;;;;
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;;     (c) Copyright 1982 Massachusetts Institute of Technology         ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10.  
  11. (in-package "MAXIMA")
  12. (macsyma-module mforma macro)
  13.  
  14. ;#+ti
  15. ;(eval-when (compile)
  16. ;  (load "cl-maxima-source:maxima;mforma.lisp"))
  17.  
  18.  
  19. ;;; A mini version of FORMAT for macsyma error messages, and other
  20. ;;; user interaction.
  21. ;;; George J. Carrette - 10:59am  Tuesday, 21 October 1980
  22.  
  23. ;;; This file is used at compile-time for macsyma system code in general,
  24. ;;; and also for MAXSRC;MFORMT > and MAXSRC;MERROR >.
  25. ;;; Open-coding of MFORMAT is supported, as are run-time MFORMAT string
  26. ;;; interpretation. In all cases syntax checking of the MFORMAT string
  27. ;;; at compile-time is done.
  28.  
  29. ;;; For the prettiest output the normal mode here will be to
  30. ;;; cons up items to pass as MTEXT forms.
  31.  
  32. ;;; Macro definitions for defining a format string interpreter.
  33. ;;; N.B. All of these macros expand into forms which contain free
  34. ;;; variables, i.e. they assume that they will be expanded in the
  35. ;;; proper context of an MFORMAT-LOOP definition. It's a bit
  36. ;;; ad-hoc, and not as clean as it should be.
  37. ;;; (Macrofy DEFINE-AN-MFORMAT-INTERPRETER, and give the free variables
  38. ;;; which are otherwise invisible, better names to boot.)
  39.  
  40. ;;; There are 3 definitions of MFORMAT.
  41. ;;; [1] The interpreter.
  42. ;;; [2] The compile-time syntax checker.
  43. ;;; [3] The open-compiler.
  44.  
  45. ;; Some commentary as to what the hell is going on here would be greatly
  46. ;; appreciated.  This is probably very elegant code, but I can't figure
  47. ;; it out. -cwh
  48. ;; This is macros defining macros defining function bodies man.
  49. ;; top-level side-effects during macroexpansion consing up shit
  50. ;; for an interpreter loop. I only do this to save address space (sort of
  51. ;; kidding.) -gjc
  52.  
  53. ;#-ti
  54. ;(DEFMACRO DEF-MFORMAT (&OPTIONAL  #-ti (type '||)
  55. ;               #+ti (TYPE  (intern "")))
  56. ;  ;; Call to this macro at head of file.
  57. ;  (PUTPROP TYPE NIL 'MFORMAT-OPS)
  58. ;  (PUTPROP TYPE NIL 'MFORMAT-STATE-VARS)
  59. ;  `(PROGN 'COMPILE
  60. ;      (DEFMACRO ,(SYMBOLCONC 'DEF-MFORMAT-OP TYPE)
  61. ;        (CHAR &REST BODY)
  62. ;        `(+DEF-MFORMAT-OP ,',TYPE ,CHAR ,@BODY))
  63. ;      (DEFMACRO ,(SYMBOLCONC 'DEF-MFORMAT-VAR TYPE)
  64. ;        (VAR VAL INIT)
  65. ;        `(+DEF-MFORMAT-VAR ,',TYPE ,VAR ,VAL ,INIT))
  66. ;      (DEFMACRO ,(SYMBOLCONC 'MFORMAT-LOOP TYPE)
  67. ;        (&REST ENDCODE)
  68. ;        `(+MFORMAT-LOOP ,',TYPE ,@ENDCODE))))
  69.  
  70.  
  71.  
  72. (DEFMACRO DEF-MFORMAT (&OPTIONAL  
  73.                 (TYPE  (intern "")))
  74.   ;; Call to this macro at head of file.
  75.   (PUTPROP TYPE NIL 'MFORMAT-OPS)
  76.   (PUTPROP TYPE NIL 'MFORMAT-STATE-VARS)
  77.   `(eval-when (compile load eval)
  78.       (DEFMACRO ,(SYMBOLCONC 'DEF-MFORMAT-OP TYPE)
  79.         (CHAR &REST BODY)
  80.         `(+DEF-MFORMAT-OP ,',TYPE ,CHAR ,@BODY))
  81.       (DEFMACRO ,(SYMBOLCONC 'DEF-MFORMAT-VAR TYPE)
  82.         (VAR VAL INIT)
  83.         `(+DEF-MFORMAT-VAR ,',TYPE ,VAR ,VAL ,INIT))
  84.       (DEFMACRO ,(SYMBOLCONC 'MFORMAT-LOOP TYPE)
  85.         (&REST ENDCODE)
  86.         `(+MFORMAT-LOOP ,',TYPE ,@ENDCODE))))
  87.  
  88.  
  89. (defmacro +def-mformat-var (TYPE var val INIT-CONDITION)
  90.   (LET #+LISPM ((DEFAULT-CONS-AREA WORKING-STORAGE-AREA)) #-LISPM NIL
  91.        ;; How about that bullshit LISPM conditionalization put in
  92.        ;; by BEE? It is needed of course or else conses will go away. -gjc
  93.        (PUSH (LIST VAR VAL)
  94.          (CDR (OR (zl-ASSOC INIT-CONDITION
  95.                 (GET TYPE 'MFORMAT-STATE-VARS))
  96.               (CAR (PUSH (NCONS INIT-CONDITION)
  97.                  (GET TYPE 'MFORMAT-STATE-VARS)))))))
  98.   `',VAR)
  99.  
  100. (defmacro +def-mformat-op (TYPE char &rest body)
  101.   ; can also be a list of CHAR's
  102.   (LET #+LISPM ((DEFAULT-CONS-AREA WORKING-STORAGE-AREA)) #-LISPM NIL
  103.        (IF (ATOM CHAR) (SETQ CHAR (LIST CHAR)))
  104.       (PUSH (CONS CHAR BODY) (GET TYPE 'MFORMAT-OPS))
  105.       `',(MAKNAM (NCONC (EXPLODEN "MFORMAT-")
  106.                 (MAPCAR #'ASCII CHAR)))))
  107.  
  108. (DEFMACRO POP-MFORMAT-ARG ()
  109.   `(COND ((= ARG-INDEX N)
  110.       (MAXIMA-ERROR "Ran out of mformat args" (LISTIFY N) 'FAIL-ACT))
  111.      (T (PROGN (SETQ ARG-INDEX (f1+ ARG-INDEX))
  112.            (ARG ARG-INDEX)))))
  113.  
  114. (DEFMACRO LEFTOVER-MFORMAT-ARGS? ()
  115.   ;; To be called after we are done.
  116.   '(OR (= ARG-INDEX N)
  117.        (MAXIMA-ERROR "Extra mformat args" (LISTIFY N) 'FAIL-ACT)))
  118.  
  119. (DEFMACRO BIND-MFORMAT-STATE-VARS (TYPE &REST BODY)
  120.   `(LET ,(DO ((L NIL)
  121.           (V (GET TYPE 'MFORMAT-STATE-VARS) (CDR V)))
  122.          ((NULL V) L)
  123.        (DO ((CONDS (CDR (CAR V)) (CDR CONDS)))
  124.            ((NULL CONDS))
  125.          (PUSH (CAR CONDS) L)))
  126.      ,@BODY))
  127.  
  128. (DEFMACRO POP-MFORMAT-STRING ()
  129.   '(IF (NULL SSTRING) 
  130.        (MAXIMA-ERROR "Runout of MFORMAT string" NIL 'FAIL-ACT)
  131.        (POP sSTRING)))
  132.  
  133. (DEFMACRO NULL-MFORMAT-STRING () '(NULL sSTRING))
  134. (DEFMACRO TOP-MFORMAT-STRING ()
  135.   '(IF (NULL sSTRING)
  136.        (MAXIMA-ERROR "Runout of MFORMAT string" NIL 'FAIL-ACT)
  137.        (CAR sSTRING)))
  138.  
  139. (DEFMACRO CDR-MFORMAT-STRING ()
  140.   `(SETQ sSTRING (CDR sSTRING)))
  141.  
  142. (DEFMACRO MFORMAT-DISPATCH-ON-CHAR (TYPE)
  143.   `(PROGN (COND ,@(MAPCAR #'(LAMBDA (PAIR)
  144.                   `(,(IF (ATOM (CAR PAIR))
  145.                      `(char= CHAR ,(CAR PAIR))
  146.                      `(OR-1 ,@(MAPCAR
  147.                            #'(LAMBDA (C)
  148.                            `(char= CHAR,C))
  149.                            (CAR PAIR))))
  150.                 ,@(CDR PAIR)))
  151.               (GET TYPE 'MFORMAT-OPS))
  152.         ;; perhaps optimize the COND to use ">" "<".
  153.         (t
  154.          (MAXIMA-ERROR "Unknown format op." (ascii char) 'FAIL-ACT)))
  155.       ,@(MAPCAR #'(LAMBDA (STATE)
  156.             `(IF ,(CAR STATE)
  157.                  (SETQ ,@(APPLY #'APPEND (CDR STATE)))))
  158.             (GET TYPE 'MFORMAT-STATE-VARS))))
  159.  
  160. (DEFMACRO OR-1 (FIRST &REST REST)
  161.   ;; So the style warnings for one argument case to OR don't
  162.   ;; confuse us.
  163.   (IF (NULL REST) FIRST `(OR ,FIRST ,@REST)))
  164.  
  165. ;(DEFMACRO WHITE-SPACE-P (X)
  166. ;  `(zl-MEMBER ,X '(#\LINEFEED #\Return #\SPACE #\TAB #-lispm #\VT #\Page)))
  167.  
  168. (DEFMACRO WHITE-SPACE-P (X)
  169.   `(zl-member ,x '(#\linefeed #\return #\space #\tab  #\page)))
  170.  
  171.  
  172.  
  173. (DEFMACRO +MFORMAT-LOOP (TYPE &REST end-code)
  174.   `(BIND-MFORMAT-STATE-VARS
  175.     ,TYPE
  176.     (DO ((CHAR))
  177.     ((NULL-MFORMAT-STRING)
  178.      (LEFTOVER-MFORMAT-ARGS?)
  179.      ,@end-code)
  180.       (SETQ CHAR (POP sSTRING))
  181.       (COND ((char= CHAR #\~)
  182.          (DO ()
  183.          (NIL)
  184.            (SETQ CHAR (POP-MFORMAT-STRING))
  185.            (COND ((char= CHAR #\@)
  186.               (SETQ |@-FLAG| T))
  187.              ((char= CHAR #\:)
  188.               (SETQ |:-FLAG| T))
  189.              ((char= CHAR #\~)
  190.               (PUSH CHAR TEXT-TEMP)
  191.               (RETURN NIL))
  192.              ((WHITE-SPACE-P CHAR)
  193.               (DO ()
  194.               ((NOT (WHITE-SPACE-P (TOP-MFORMAT-STRING))))
  195.             (CDR-MFORMAT-STRING))
  196.               (RETURN NIL))
  197.              ((OR (#+cl char< #-cl <
  198.                 CHAR #\0) ( #+cl char> #-cl >
  199.                     CHAR #\9))
  200.               (MFORMAT-DISPATCH-ON-CHAR ,TYPE)
  201.               (RETURN NIL))
  202.              (T
  203.               (SETQ PARAMETER
  204.                 (f+ (f- (char-code char) (char-code #\0))
  205.                    (f* 10. PARAMETER))
  206.                 PARAMETER-P T)))))
  207.  
  208.         (T
  209.          (PUSH CHAR TEXT-TEMP))))))
  210.  
  211.  
  212. ;;; The following definitions of MFORMAT ops are for compile-time,
  213. ;;; the runtime definitions are in MFORMT.
  214.  
  215. (defvar WANT-OPEN-COMPILED-MFORMAT NIL)
  216. (defvar CANT-OPEN-COMPILE-MFORMAT NIL)
  217.  
  218.  
  219. (DEF-MFORMAT |-C|)
  220.  
  221.      
  222. (DEF-MFORMAT-VAR-C |:-FLAG|     NIL T)
  223. (DEF-MFORMAT-VAR-C |@-FLAG|     NIL T)
  224. (DEF-MFORMAT-VAR-C PARAMETER   0  T) 
  225. (DEF-MFORMAT-VAR-C PARAMETER-P NIL T)
  226. (DEF-MFORMAT-VAR-C TEXT-TEMP NIL NIL)
  227. (DEF-MFORMAT-VAR-C CODE NIL NIL)
  228.  
  229. (DEFMACRO EMITC (X)
  230.   `(PUSH ,X CODE))
  231.  
  232. (DEFMACRO PUSH-TEXT-TEMP-C ()
  233.   '(AND TEXT-TEMP
  234.     (PROGN (EMITC `(PRINC ',(MAKNAM (NREVERSE TEXT-TEMP)) ,STREAM))
  235.            (SETQ TEXT-TEMP NIL))))
  236.  
  237. (DEF-MFORMAT-OP-C (#\% #\&)
  238.   (COND (WANT-OPEN-COMPILED-MFORMAT
  239.      (PUSH-TEXT-TEMP-C)
  240.      (IF (char= CHAR #\&)
  241.          (EMITC `(CURSORPOS 'A ,STREAM))
  242.          (EMITC `(TERPRI ,STREAM))))))
  243.  
  244. (DEF-MFORMAT-OP-C #\M
  245.   (COND (WANT-OPEN-COMPILED-MFORMAT
  246.      (PUSH-TEXT-TEMP-C)
  247.      (EMITC `(,(IF |:-FLAG| 'MGRIND 'DISPLAF)
  248.           (,(IF |@-FLAG| 'GETOP 'PROGN)
  249.            ,(POP-MFORMAT-ARG))
  250.           ,STREAM)))
  251.     (T (POP-MFORMAT-ARG))))
  252.  
  253. (DEF-MFORMAT-OP-C (#\A #\S)
  254.   (COND (WANT-OPEN-COMPILED-MFORMAT
  255.      (PUSH-TEXT-TEMP-C)
  256.      (EMITC `(,(IF (char= CHAR #\A) 'PRINC 'PRIN1)
  257.           ,(POP-MFORMAT-ARG)
  258.           ,STREAM)))
  259.     (T (POP-MFORMAT-ARG))))
  260.  
  261. (DEFUN OPTIMIZE-PRINT-INST (L)
  262.   ;; Should remove extra calls to TERPRI around DISPLA.
  263.   ;; Mainly want to remove (PRINC FOO NIL) => (PRINC FOO)
  264.   ;; although I'm not sure this is correct. geezz.
  265.   (DO ((NEW NIL))
  266.       ((NULL L) `(PROGN ,@NEW))
  267.     (LET ((A (POP L)))
  268.       (COND ((EQ (CAR A) 'TERPRI)
  269.          (COND ((EQ (CADR A) NIL)
  270.             (PUSH '(TERPRI) NEW))
  271.            (T (PUSH A NEW))))
  272.         ((AND (EQ (CADDR A) NIL)
  273.           (NOT (EQ (CAR A) 'MGRIND)))
  274.          (COND ((EQ (CAR A) 'DISPLAF)
  275.             (PUSH `(DISPLA ,(CADR A)) NEW))
  276.            (T
  277.             (PUSH `(,(CAR A) ,(CADR A)) NEW))))
  278.         (T
  279.          (PUSH A NEW))))))
  280.  
  281. (DEFMACRO NORMALIZE-STREAM (STREAM)
  282.   STREAM
  283.   #+ITS `(IF (EQ ,STREAM '*terminal-io*)
  284.          (SETQ ,STREAM 'TYO))
  285.   #-ITS NIL)
  286.  
  287. (DEFmfUN MFORMAT-TRANSLATE-OPEN N
  288.   (LET ((STREAM (ARG 1))
  289.     (sSTRING (EXPLODEN (ARG 2)))
  290.     (WANT-OPEN-COMPILED-MFORMAT T)
  291.     (CANT-OPEN-COMPILE-MFORMAT NIL)
  292.     (ARG-INDEX 2))
  293.     (NORMALIZE-STREAM STREAM)
  294.     (MFORMAT-LOOP-C
  295.      (PROGN (PUSH-TEXT-TEMP-C)
  296.         (IF CANT-OPEN-COMPILE-MFORMAT
  297.         (MAXIMA-ERROR "CAN'T OPEN COMPILE MFORMAT ON THIS CASE."
  298.                (LISTIFY N)
  299.                'FAIL-ACT
  300.                ))
  301.         (OPTIMIZE-PRINT-INST CODE)))))
  302.  
  303. (DEFmfUN MFORMAT-SYNTAX-CHECK N
  304.   (LET ((ARG-INDEX 2)
  305.     (STREAM NIL)
  306.     (sSTRING (EXPLODEN (ARG 2)))
  307.     (WANT-OPEN-COMPILED-MFORMAT NIL))
  308.     (MFORMAT-LOOP-C NIL)))
  309.  
  310.  
  311. (defmacro progn-pig (&rest l) `(progn ,@l))
  312.  
  313. (DEFUN PROCESS-MESSAGE-ARGUMENT (X)
  314.   ;; Return NIL if we have already processed this
  315.   ;; message argument, NCONS of object if not
  316.   ;; processed.
  317.   (IF (AND (NOT (ATOM X))
  318.        (MEMQ (CAR X) '(OUT-OF-CORE-STRING PROGN-pig)))
  319.       NIL
  320.       (NCONS (IF (AND (STRINGP X) (STATUS FEATURE ITS))
  321.          `(OUT-OF-CORE-STRING ,X)
  322.          `(PROGN-pig ,X)))))
  323.  
  324. (DEFUN MFORMAT-TRANSLATE (ARGUMENTS COMPILING?)
  325.   (LET (((STREAM sSTRING . OTHER-SHIT) ARGUMENTS))
  326.     (let ((mess (process-message-argument sstring)))
  327.       (COND ((NULL MESS) NIL)
  328.         ('On-the-other-hand
  329.          (SETQ MESS (CAR MESS))
  330.          (NORMALIZE-STREAM STREAM)
  331.          (IF (AND (STRINGP sSTRING) COMPILING?)
  332.          (APPLY #'MFORMAT-SYNTAX-CHECK
  333.                 STREAM sSTRING OTHER-SHIT))
  334.          `(,(OR (CDR (zl-ASSOC (f+ 2            ; two leading args.
  335.                    (LENGTH OTHER-SHIT))
  336.                 '((2 . *MFORMAT-2)
  337.                   (3 . *MFORMAT-3)
  338.                   (4 . *MFORMAT-4)
  339.                   (5 . *MFORMAT-5))))
  340.            'MFORMAT)
  341.            ,STREAM
  342.            ,MESS
  343.            ,@OTHER-SHIT))))))
  344.  
  345. (DEFUN MTELL-TRANSLATE (ARGUMENTS COMPILING?)
  346.   (LET (((sSTRING . OTHER-SHIT) ARGUMENTS))
  347.     (LET ((MESS (PROCESS-MESSAGE-ARGUMENT sSTRING)))
  348.       (COND ((NULL MESS) NIL)
  349.         ('ON-THE-OTHER-HAND
  350.          (SETQ MESS (CAR MESS))
  351.          (IF (AND (STRINGP sSTRING) COMPILING?)
  352.          (APPLY #'MFORMAT-SYNTAX-CHECK
  353.                 NIL SSTRING OTHER-SHIT))
  354.          `(,(OR (CDR (zl-ASSOC (f+ 1 (LENGTH OTHER-SHIT))
  355.                 '((1 . MTELL1)
  356.                   (2 . MTELL2)
  357.                   (3 . MTELL3)
  358.                   (4 . MTELL4)
  359.                   (5 . MTELL5))))
  360.             'MTELL)
  361.            ,MESS
  362.            ,@OTHER-SHIT))))))
  363.  
  364. (DEFMACRO MFORMAT-OPEN (STREAM SSTRING &REST OTHER-SHIT)
  365.   (IF (NOT (STRINGP SSTRING))
  366.       (MAXIMA-ERROR "Not a string, can't open-compile the MFORMAT call"
  367.          SSTRING 'FAIL-ACT)
  368.       (APPLY #'MFORMAT-TRANSLATE-OPEN
  369.              STREAM
  370.              SSTRING
  371.              OTHER-SHIT)))
  372.  
  373. (DEFMACRO MTELL-OPEN (MESSAGE &REST OTHER-SHIT)
  374.   `(MFORMAT-OPEN NIL ,MESSAGE . ,OTHER-SHIT))
  375.  
  376. (DEFUN MERROR-TRANSLATE (ARGUMENTS COMPILING?)
  377.   (LET (((MESSAGE . OTHER-SHIT) ARGUMENTS))
  378.     (LET ((MESS (PROCESS-MESSAGE-ARGUMENT MESSAGE)))
  379.       (COND ((NULL MESS) NIL)
  380.         ('ON-THE-OTHER-HAND
  381.          (IF (AND (STRINGP MESSAGE) COMPILING?)
  382.          (APPLY #'MFORMAT-SYNTAX-CHECK
  383.                NIL
  384.                MESSAGE OTHER-SHIT))
  385.          (SETQ MESS (CAR MESS))
  386.          `(,(OR (CDR (zl-ASSOC (f+ 1 (LENGTH OTHER-SHIT))
  387.                 '((1 . *MERROR-1)
  388.                   (2 . *MERROR-2)
  389.                   (3 . *MERROR-3)
  390.                   (4 . *MERROR-4)
  391.                   (5 . *MERROR-5))))
  392.             'MERROR)
  393.            ,MESS
  394.            ,@OTHER-SHIT))))))
  395.  
  396. (DEFUN ERRRJF-TRANSLATE (ARGUMENTS COMPILING?)
  397.   (LET (((MESSAGE . OTHER-SHIT) ARGUMENTS))
  398.     (LET ((MESS (PROCESS-MESSAGE-ARGUMENT MESSAGE)))
  399.       (COND ((NULL MESS) NIL)
  400.         ('ON-THE-OTHER-HAND
  401.          (IF (AND (STRINGP MESSAGE) COMPILING?)
  402.          (APPLY #'MFORMAT-SYNTAX-CHECK
  403.                NIL
  404.                MESSAGE OTHER-SHIT))
  405.          (SETQ MESS (CAR MESS))
  406.          `(,(OR (CDR (zl-ASSOC (f+ 1 (LENGTH OTHER-SHIT))
  407.                 '((1 . *ERRRJF-1))))
  408.             'ERRRJF)
  409.            ,MESS ,@OTHER-SHIT))))))
  410. #+PDP10
  411. (PROGN 'COMPILE
  412.  
  413. (DEFUN GET-TRANSLATOR (OP)
  414.   (OR (GET OP 'TRANSLATOR)
  415.       (GET-TRANSLATOR (MAXIMA-ERROR "has no translator" OP 'wrng-type-arg))))
  416.  
  417. (DEFVAR SOURCE-TRANS-DRIVE NIL)
  418. (DEFUN SOURCE-TRANS-DRIVE (FORM)
  419.   (LET ((X (FUNCALL (GET-TRANSLATOR (CAR FORM)) (CDR FORM) T)))
  420.     (WHEN (AND X SOURCE-TRANS-DRIVE)
  421.       (PRINT FORM TYO)
  422.       (PRINC "==>" TYO)
  423.       (PRINT X TYO))
  424.     (IF (NULL X) (VALUES FORM NIL) (VALUES X T))))
  425. (DEFUN PUT-SOURCE-TRANS-DRIVE (OP TR)
  426.   (PUTPROP OP '(SOURCE-TRANS-DRIVE) 'SOURCE-TRANS)
  427.   (PUTPROP OP TR 'TRANSLATOR))
  428.  
  429. (PUT-SOURCE-TRANS-DRIVE 'MFORMAT 'MFORMAT-TRANSLATE)
  430. (PUT-SOURCE-TRANS-DRIVE 'MTELL 'MTELL-TRANSLATE)
  431. (PUT-SOURCE-TRANS-DRIVE 'MERROR 'MERROR-TRANSLATE)
  432. (PUT-SOURCE-TRANS-DRIVE 'ERRRJF 'ERRRJF-TRANSLATE)
  433. )
  434.  
  435. ;;; Other systems won't get the syntax-checking at compile-time
  436. ;;; unless we hook into their way of doing optimizers.
  437.  
  438.